;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Modifcations of regresson spreadplots for containers
;; made by Forrest young, Feb 2000, for Verson 6.0alpha9.
;;
;; Contains code for three SpreadPlots: 
;; Simple, OLS/Monotone and Robust Reg
;;
;; For each SpreadPlot, the approach taken involves two steps:
;;
;; 1) Use Carla Bann's unmodified spreadplot code to create, 
;;    inside a container, her `plots and original spreadplot, 
;;    but not to show any of them.
;; 2) Then rearrange them inside the container using the modern
;;    spreadplot layout architecture, but keep the original
;;    messageing system.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth morals-model-object-proto :visualize ()
  (cond 
    ((send self :prev-vis)
     (let ((c (send self :container))
           (ur (if (> (uniform-rand 1) .5) 1 -1))
           )
       (send c :show-window)
       (when (send c :has-slot 'influ-cntlpanl-item-objid)
             (send (send c :slot-value 'influ-cntlpanl-item-objid) :value nil))
       (when (send c :has-slot 'range-cntlpanl-item-objid) 
             (send (send c :slot-value 'range-cntlpanl-item-objid) :value nil))
       (apply #'send c :size (+ ur (send c :size)))))
    (t
     (send self :prev-vis t)
     (let ((msp (send self :create-spreadplot)))   ;old-style
       (if (send msp :simple-reg)
           (send self :modern-simplreg-splot msp)  ;new-style
           (send self :modern-spreadplot msp)))
     (send (send self :container) :add-slot 'influ-cntlpanl-item-objid)
     (send (send self :container) :add-slot 'range-cntlpanl-item-objid) 
      ))
  )

; ___________________________________________________________________
;
; MODERN SIMPLE REGRESSION SPREADPLOT
; ___________________________________________________________________



(defmeth morals-model-object-proto :modern-simplreg-splot (msp)
  (let* ((c (send self :container))
         (simpreg (send msp :added-var-plot))
         (obs (send msp :obs-list))
         (res (send msp :residual-plot2))
         (inf (send msp :influence-plot1))
         (cp)
         (plot-matrix (matrix '(2 4)

             (list  obs simpreg nil res
                    nil nil     nil inf)))
         (splot (spreadplot plot-matrix 
                      :rel-widths '(.5 1 1 1)
                      :span-right (matrix '(2 4) (list 1 2 0 1  0 0 0 1))
                      :span-down  (matrix '(2 4) (list 2 2 0 1  0 0 0 1))))
         (cntlpanl (send simpreg :simpreg-control-panel splot msp))
         )
    (send msp :plot-matrix plot-matrix)
    (send msp :make-links (list obs simpreg res inf))
    (send msp :link-plots (list obs simpreg res inf))
    (send splot :make-spreadplot-container-resize c)
    (send (send msp :lin-reg-plot) :hide-window)
    (send (send msp :influence-plot2) :hide-window)
    (send simpreg :fix-resids-plot msp)
    (send cntlpanl :frame-location 
          (floor (/ (first  (- (screen-size) (send cntlpanl :size))) 2))
          0)
    (send c :frame-location 0 (second (send cntlpanl :frame-size)))
    (send c :show-window)
    (apply #'send c :size (send c :fix-splot-size (send c :size)))
    (send c :show-window)
    (send c :add-subordinate cntlpanl)
    (send c :front-window)
    (defmeth c :show-window ()
      (call-next-method)
      (send cntlpanl :show-window))
    (defmeth c :close ()
      (send c :hide-window)
      (send cntlpanl :hide-window))
    (defmeth cntlpanl :close ()
      (send cntlpanl :hide-window)
      (send c :hide-window))
    (disable-container)
    c))
; ___________________________________________________________________
;
; MULTIPLE REGRESSION SPREADPLOTS (OLS/MONOTONE AND ROBUST)
; ___________________________________________________________________


(defmeth morals-model-object-proto :modern-spreadplot (msp)
  (send msp :container (send self :container))
  (send msp :iter-container *iter-container*)
  (let* ((c (send self :container))
         (enabled (enable-container c))
         (method (send self :method))
         (avp (send msp :added-var-plot))
         (lsmt (send msp :transformation-plot))
         (reg (send msp :lin-reg-plot))
         (resid (send msp :residual-plot2))
         (dummy (unless (equal "Robust" method)
                        (send reg :show-window)))
         (dv (select (send self :variables) (send self :dv)))
         (dv (if (listp dv) (select dv 0) dv))
         (cntlpanl (send lsmt :reg-control-panel))
         (plot-matrix (matrix'(2 3) 
           (list (send msp :slot-value 'obs-list)
                 (cond 
                   ((equal "Robust" method )
                    (list
                     (send msp :lin-reg-plot)
                     (send msp :transformation-plot)
                     (send msp :added-var-plot)
                     (send msp :robust-reg-plot)))
                   (t
                    (list
                     (send msp :lin-reg-plot)
                     (send msp :added-var-plot)
                     (send msp :transformation-plot)
                     )))
                 (send msp :residual-plot2)
                 nil
                 (send msp :influence-plot1)
                 (send msp :influence-plot2)
                 )))
         (plot-list (remove 'nil (combine plot-matrix)))
         (splot (spreadplot plot-matrix
                  :rel-widths '(.6 1.5 1.5)
                  :rel-heights '(1.4 1) ;(1.5 1)
                  :span-down (matrix '(2 3) '(2 1 1 0 1 1))))
         (plot-matrix2)
         (splot2))
         
    (send (send msp :influence-plot2) :show-window)
    (send msp :plot-matrix plot-matrix)
    (send msp :make-links plot-list)
    (send msp :link-plots plot-list)
    (send (send msp :change-plot) :show-window)
    (when (equal "Robust" method)
          (send msp :resid-type1 "RR-Bayes")
          (send msp :resid-type2 "RR-Bayes")
          (send msp :infl-type1 "RR-Cooks")
          (send msp :infl-type2 "RR-Lev")
          (send msp :update-robust-plot)
          (send msp :update-robust-reg-plot)
          (send msp :update-residual-plot)
          (send msp :update-influence-plot)
          (send (send msp :change-plot) :y-axis t t 3)
          (send (send msp :robust-plot) :y-axis t t 3)
          (send (send lsmt :spreadplot-supervisor) 
                :get-residuals resid 5)
          (mapcar #'(lambda (plot)
                      (when (and plot (send plot :has-slot 'legend1))
                            (send plot :legend1 "Robust Regression")))
                  (combine plot-matrix plot-matrix2))
          
          )
    (when (equal "Monotonic" method)
          (send lsmt :clear-lines)
          (send lsmt :show-reg t)
          (send lsmt :variable-label '(0 1)
                (list (strcat "Fitted " dv) dv))
          (send lsmt :legend2 "Regression & Fit")
          (send lsmt :show-linear t 1)
          (send resid :variable-label 0 (strcat "Fitted " dv))
          (send (send msp :influence-plot1) 
                :variable-label '(0 1) 
                (list (strcat "Fitted " dv) "Cook's Distances"))
          (mapcar #'(lambda (plot)
                      (when (and plot (send plot :has-slot 'legend1))
                            (if (= 0 (send self :control-panel-method))
                                (send plot :legend1 "Least Squares Regression")
                                (send plot :legend1 "Monotonic Regression"))))
                  (combine plot-matrix plot-matrix2))
          )
    (send avp :title "Conditional Regression (Added Variable Plot)")
    (send splot  :make-spreadplot-container-resize c)
    ;(send msp :update-legends)
    
    (unless (equal "Robust" method)(send lsmt :front-window))
    (send c :frame-location 0 0)
    (apply #'send c :size (- (effective-screen-size) '(150 0)))
    (send c :show-window)
    (when (> (send self :control-panel-method) 0)
          (setf plot-matrix2 (matrix '(1 2)
                       (list (if (equal "Robust" method )
                                 (send msp :robust-plot) 
                                 (send msp :rsq-beta-plot))
                             (send msp :change-plot))))
          (setf splot2 (spreadplot plot-matrix2 
                             :rel-widths '(.75 .75)
                             :container *iter-container*))
         ; (send (aref plot-matrix2 0 0) :legend1 " ")
         ; (send (aref plot-matrix2 0 1) :legend1 " ")
           (send splot2 :make-spreadplot-container-resize *iter-container*)
          (send splot2 :size 360 180)
         ; (apply #'send *iter-container* :size (send splot2 :size))
          (apply #'send *iter-container* :location 
           (- (effective-screen-size) (send *iter-container* :size) ))
          (send splot2 :show-window)
          (send *iter-container* :size 280 214)
          (apply #'send *iter-container* :frame-location (- (effective-screen-size) 
                                 (send *iter-container* :frame-size)))
          
          (send *cntl-panl-iter-method* :do-action)
          ;(send lsmt :do-another-visualization 
          ;      (send self :control-panel-method) t splot)
          );new by fwy august 2001
    (disable-container)
    (send cntlpanl :location (- (first (effective-screen-size)) 143) 0)
    (send cntlpanl :show-window)
    (send cntlpanl :frame-location (- (first (effective-screen-size)) 143) 0)
    (send cntlpanl :size 135 (second (send cntlpanl :size)))
    (mapcar #'(lambda (plot)
                (defmeth plot :close ()
                  (send (first (send self :overlays)) :switch-pop-state)))
            (combine plot-matrix))

    (defmeth cntlpanl :close ()
      (send self :hide-window)
      (send *iter-container* :hide-window)
      (send c :hide-window))

    (defmeth c :show-window ()
      (call-next-method)
      (send cntlpanl :show-window)
      (setf *current-spreadplot* c))

    (defmeth *iter-container* :close () 
      (send self :hide-window))

    (defmeth c :close () 
      (send self :hide-window)
      (send *iter-container* :hide-window)
      (send cntlpanl :hide-window))

    (setf *current-spreadplot* c)

    (send msp :fix-help-menu)
    c))

(defmeth morals-spreadplot-supervisor-proto :link-plots (plot-list) 
  (mapcar #'(lambda (plot)
              (send plot :linked t))
          plot-list))



(defmeth morals-spreadplot-supervisor-proto :make-links (plot-list)
  ;(send self :obs-plots plot-list)
  (mapcar 
   #'(lambda (plot)
       (unless (send plot :has-slot 'plot-group)
               (send plot :add-slot 'plot-group))
       (defmeth plot :plot-group (&optional (plot-group nil used?))
         (if used? (setf (slot-value 'plot-group) plot-group))
         (slot-value 'plot-group))
       (send plot :plot-group plot-list)
       (defmeth plot :links ()
         (let ((plot-group (send plot :plot-group)))
           (if (member self plot-group) plot-group)))
       (defmeth plot :linked (&optional (link nil used?))
         (let ((plot-group (send plot :plot-group)))
           (when used? 
                 (setf plot-group 
                       (if link (cons plot plot-group)
                           (remove plot plot-group)))
                 (call-next-method link))
           (call-next-method)))
       )
   plot-list)
  plot-list)



(defmeth morals-spreadplot-supervisor-proto :make-ITER-links (plot-list)
  ;(send self :obs-plots plot-list)
  (mapcar 
   #'(lambda (plot)
       (unless (send plot :has-slot 'iter-group)
               (send plot :add-slot 'iter-group))
       (defmeth plot :iter-group (&optional (iter-group nil used?))
         (if used? (setf (slot-value 'iter-group) iter-group))
         (slot-value 'iter-group))
       (send plot :iter-group plot-list)
       (defmeth plot :links ()
         (let ((iter-group (send plot :iter-group)))
           (if (member self iter-group) iter-group)))
       (defmeth plot :linked (&optional (link nil used?))
         (let ((iter-group (send plot :iter-group)))
           (when used? 
                 (setf iter-group 
                       (if link (cons plot iter-group)
                           (remove plot iter-group)))
                 (call-next-method link))
           (call-next-method)))
       )
   plot-list)
  plot-list)

#|


(defmeth morals-spreadplot-supervisor-proto :make-main-links (plot-list &optional plot-group-symbol)  
  (send self :obs-plots plot-list)
  (mapcar 
   #'(lambda (plot)
       (case plot-type-num
         (0 (unless (send plot :has-slot 'plot-group)
                    (send plot :has-slot 'plot-group)
       (defmeth plot :plot-group (&optional (plot-group nil used?))
         (if used? (setf (slot-value 'plot-group) plot-group))
         (slot-value 'plot-group))
       (send plot :plot-group plot-list)
       (defmeth plot :links ()
         (let ((plot-group (send plot :plot-group)))
           (if (member self plot-group) plot-group)))
       (defmeth plot :linked (&optional (link nil used?))
         (let ((plot-group (send plot :plot-group)))
           (when used? 
                 (setf plot-group 
                       (if link (cons plot plot-group)
                           (remove plot plot-group)))
                 (call-next-method link))
           (call-next-method)))
       )
   plot-list)
  plot-list)

(defmeth morals-spreadplot-supervisor-proto :make-links (plot-list &optional plot-type-symbol)
  (send self (if (equal plot-type-symbol 'main) ':main ':iter) plot-list)
  (mapcar 
   #'(lambda (plot)
       (case plot-type-num
         (0 (unless (send plot :has-slot `',plot-group)
                    (send plot :has-slot `',plot-group)
       (defmeth plot :plot-group (&optional (plot-group nil used?))
         (if used? (setf (slot-value `',plot-group) `,plot-group))
         (slot-value `',plot-group))
       (send plot :plot-group plot-list)
       (defmeth plot :links ()
         (let ((`,plot-group (send plot (case plot-group-symbol (:plot-group)))
           (if (member self `,plot-group) `,plot-group)))
       (defmeth plot :linked (&optional (link nil used?))
         (let ((`,plot-group (send plot :plot-group)))
           (when used? 
                 (setf `,plot-group 
                       (if link (cons plot `,plot-group)
                           (remove plot `,plot-group)))
                 (call-next-method link))
           (call-next-method)))
       )
   plot-list)
  plot-list)




; original non-working version fwy 0820
(defmeth morals-spreadplot-supervisor-proto :make-links (plot-list &optional plot-type)    
  (send self :obs-plots plot-list)
  (mapcar 
   #'(lambda (plot)

       (unless (send plot :has-slot (if plot-type 'main-plots iter-plots))
               (send plot :add-slot (if plot-type 'main-plots iter-plots)))
       (defmeth plot :obs-plots (&optional (obj-list nil used?))
         (if used? (setf (slot-value 'obs-plots) obj-list))
         (slot-value 'obs-plots))
       (send plot :obs-plots plot-list)
       (defmeth plot :links ()
         (let ((obs-plots (send plot :obs-plots)))
           (if (member self obs-plots) obs-plots)))
       (defmeth plot :linked (&optional (link nil used?))
         (let ((obs-plots (send plot :obs-plots)))
           (when used? 
                 (setf obs-plots 
                       (if link (cons plot obs-plots)
                           (remove plot obs-plots)))
                 (call-next-method link))
           (call-next-method)))
       )
   plot-list)
  plot-list)
|#
(defmeth morals-spreadplot-supervisor-proto :obs-plots (&optional (obj-list nil arg-used))
  (if arg-used (setf (slot-value 'obs-plots) obj-list))
  (slot-value 'obs-plots))

(defmeth morals-spreadplot-supervisor-proto :fix-help-menu ()
  (let* ((hi (reverse (send *help-menu* :items)))
         (last-item)
         )
    (dotimes (i (length hi))
             (setf last-item (select hi i))
             (if (equal dash-item-proto (first (send last-item :parents)))
                 (send *help-menu* :delete-items last-item)
                 (return)))))


(defmeth morals-spreadplot-supervisor-proto :reveal-iter-window (iter-window)
  (send iter-window :value t)
  (send (send self :iter-container) :front-window)
  (pause 20)
  (send iter-window :value nil))

;fwy made changes in the following to have studentized residuals always used
;whether or not bayesing confidence intervals are shown
(defmeth morals-spreadplot-supervisor-proto :get-residuals (plot &optional choice)  
  (let* (
         (resid-list (list "MR-Raw" "MR-Bayes" "MR-Student" "MR-External"  
                           "RR-Raw" "RR-Bayes" "RR-Student" "RR-External"
                           "LR-Raw" "LR-Bayes" "LR-Student" "LR-External"))
         (mod (send self :model))        
         (morals-model (send mod :morals-model))
         (model (if (equalp (send mod :method) "Robust") 
                    (send mod :robust-model) morals-model))
         (lin-reg (send mod :lin-reg-model))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (bayres "Bayes Residuals")
         (stdres "Standardized Residuals")
         (res "Residuals")
         (pindex nil)
         (i 0)
         (initial-index nil)
         (resid-type nil)
        ; (choice nil)
         (r (/ (send model :residuals) (send model :sigma-hat)))
         (r2 (/ (send lin-reg :residuals) (send lin-reg :sigma-hat)))
         (d (* 2 (sqrt (send model :leverages))))
         (low (- r d))
         (high (+ r d))
         (d2 (* 2 (sqrt (send lin-reg :leverages))))
         (low2 (- r2 d2))
         (high2 (+ r2 d2))
         (x-values (send model :fit-values))
         (x-values2 (send lin-reg :fit-values))
         (labels (send mod :labels))
         (color 'black)
         (npts (send (send self :transformation-plot) :num-points))
         (indices (iseq npts))
         (point-colors (send (send self :transformation-plot) :point-color (iseq npts)))
         (point-symbols)
         (gnr)
        )
    (defmeth plot :point-color (i &optional color)
      (cond
        (color
         (call-next-method i color)
         (send plot :linestart-color (* 2 i) 
               (send self :point-color i)))
        (t
         (call-next-method i))))
      
    (defmeth plot :adjust-to-residual-data (axis values)
      (let ((gnr (get-nice-range (min values) (max values) 5)))
        (send plot :range axis (first gnr) (second gnr))
        (if (= axis 0)
            (send plot :x-axis t t (third gnr))
            (send plot :y-axis t t (third gnr)))))

    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp plot (send self :residual-plot1)) (setf pindex 1) (setf pindex 2)) 
    (if (= pindex 1) (setf resid-type (send self :resid-type1)) 
        (setf resid-type (send self :resid-type2)))
    (dotimes (i 12)
             (if (equalp resid-type (select resid-list i))
                  (setf initial-index i)))
    (send plot :clear-lines)
    (case choice
      (0 ;OLS residuals
         ; Aug 4 2001 - fwy changed next two lines to following two
         ;(send plot :point-coordinate 0 indices (send lin-reg :fit-values))
         ;(send plot :point-coordinate 1 indices (send lin-reg :raw-residuals))
         (send plot :point-coordinate 0 indices x-values2)	
         (send plot :point-coordinate 1 indices r2)
         ; Aug 4 2001 - fwy changed LR-Raw to LR-Student in next two lines
         (if (= pindex 1) (send self :resid-type1 "LR-Student") ;LR-Raw
             (send self :resid-type2 "LR-Student"))) ;LR-Raw
      (1 ;OLS bayes residuals
         (send plot :point-coordinate 0 indices x-values2)
         (send plot :point-coordinate 1 indices r2)
         (map 'list #'(lambda (a b c d i) 
                        (send plot :plotline a b c d nil)
                        (send plot :linestart-color (* 2 i) 
                              (send plot :point-color i))
                        )
               x-values2 low2 x-values2 high2 indices)
         (if (= pindex 1) (send self :resid-type1 "LR-Bayes") 
             (send self :resid-type2 "LR-Bayes")))
      
      (4 ;monotone or robust residuals
        ; Aug 4 2001 - fwy changed next two lines to following two
        ;(send plot :point-coordinate 0 indices (send model :fit-values))
        ;(send plot :point-coordinate 1 indices (send model :residuals)) 
         (send plot :point-coordinate 0 indices x-values)	         
         (send plot :point-coordinate 1 indices r)
        ; Aug 4 2001 - fwy changed LR-Raw to LR-Student in next two lines
         (if (= pindex 1) (send self :resid-type1 "MR-Student") ;LR-Raw
             (send self :resid-type2 "MR-Student"))) ;LR-Raw
      (5 ;monotone or robust bayes residuals
         (send plot :point-coordinate 0 indices x-values )
         (send plot :point-coordinate 1 indices r)
         (map 'list #'(lambda (a b c d i)
                        (send plot :plotline a b c d nil)
                        (send plot :linestart-color (* 2 i) 
                              (send plot :point-color i))
                        )
               x-values low x-values high indices)
         (if (= pindex 1) (send self :resid-type1 "MR-Bayes") 
             (send self :resid-type2 "MR-Bayes"))))
    ;fwy aug 4 2001 made changes below to show new labeling
    (cond
      ((or (= choice 1) (= choice 5))
       (send plot :title res);bayres
       (send plot :Legend2 res);bayres
       (send plot :variable-label 1 stdres)
       (send plot :adjust-to-residual-data 0 (combine x-values x-values2))
       (send plot :adjust-to-residual-data 1 (combine low low2 high high2)))
      ((or (= choice 0) (= choice 4))
       (send plot :title res)
       (send plot :Legend2 res)
       (send plot :variable-label 1 stdres);res
       (send plot :adjust-to-residual-data 0 (combine x-values x-values2));(send model :fit-values)
       (send plot :adjust-to-residual-data 1 (combine low low2 high high2)));(send model :residuals)))
      (t (error-message "bad choice drawing residuals")))
    (send plot :abline 0 0)
       
    ))

